Questiohs

  1. define projection.
  2. do some editing.
  3. intersect with an existing shapefile.
  4. calculate area of obtained polygons

Packages

library(tidyverse)
library(sf)
library(tmap)
library(leaflet)

Data

ucsfi <- read_sf("data/ucsfi.shp")  # %>% `st_crs<-`(3857)  # 3857 is Web mercator
brazil0 <- read_sf("data/BRA_adm/BRA_adm0.shp")

Projection

In the above code chunk projection is commented out because tmap appears to work beset without the projection assigned. We’ll do that later. assigned with st_crs() using a somewhat non-standard syntax. However, It seemed to be the only way I could add a projection to this particular shapefile. Below are some other syntax examples that have worked for me with other shapefiles. Of course there are various ways to add projection and since this is R, there’s more than one way to accomplish the goal.

sf::st_crs(3857)
sf::st_transform(3857)
ggplot2::coord_sf(crs = 3857)   # must use the development version of ggplot2

Notes on Projection

From Brazillian CRS

  • 4989
  • 4674
  • 5527
  • 4618

Check Projection

st_crs(ucsfi)
Coordinate Reference System: NA
print("ucsfi above ^^^  --------- brazil0 below")
[1] "ucsfi above ^^^  --------- brazil0 below"
st_crs(brazil0)
Coordinate Reference System:
  EPSG: 4326 
  proj4string: "+proj=longlat +datum=WGS84 +no_defs"
# or check the projection for an individual polygon ...
# ucsfi$geometry %>% head(1) 

First View With Projection

Data Preview

as_tibble(ucsfi)
Simple feature collection with 147 features and 13 fields
geometry type:  MULTIPOLYGON
dimension:      XY
bbox:           xmin: -73.99068 ymin: -32.92342 xmax: -32.35011 ymax: 5.272257
epsg (SRID):    NA
proj4string:    NA

Wrangle Data

I want to use a numeric data type as my “fill”

ucsfi <- ucsfi %>% 
  mutate(GID7 = as.numeric(GID7))

First Look with tmap

tmap_mode("plot")
tmap mode set to plotting
tm_shape(brazil0, projection = 3857) + tm_fill() + tm_text("NAME_0", auto.placement = FALSE) +
  tm_shape(ucsfi, projection = 3857) + tm_fill("GID7", palette = rev(sf.colors()))
Currect projection of shape ucsfi unknown. Long-lat (WGS84) is assumed.

ggplot

ucsfi %>% 
  mutate(ANO_CRIA6 = as.numeric(ANO_CRIA6)) %>% 
  ggplot() +
  geom_sf(aes(fill = ANO_CRIA6, color = ANO_CRIA6)) 
NAs introduced by coercion

Look 3 – Leaflet

MapPalette <- colorQuantile(palette = "viridis", domain = ucsfi$GID7, n = 7, reverse = TRUE)
ucsfi %>% 
  leaflet(width = "100%") %>% 
  addProviderTiles( provider = "CartoDB.Positron") %>% 
  addPolygons(popup = ~ ID_UC0,
              stroke = FALSE,
              smoothFactor = 0,
              fillOpacity = 0.7,
              color = ~ MapPalette(GID7)) 

#+
#  addLegend("bottomright", 
#              pal = MapPalette, 
#              values = ~ GID7,
#              title = "GID7",
#              opacity = 1)
LS0tDQp0aXRsZTogIlNvbHV0aW9ucyINCmF1dGhvcjogIkpvaG4gTGl0dGxlIg0KZGF0ZTogIkZlYi4gMjAsIDIwMTgiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQoNCiMjIFF1ZXN0aW9ocw0KDQoNCg0KMS4gZGVmaW5lIHByb2plY3Rpb24uDQoyLiBkbyBzb21lIGVkaXRpbmcuIA0KMy4gaW50ZXJzZWN0IHdpdGggYW4gZXhpc3Rpbmcgc2hhcGVmaWxlLiANCjQuIGNhbGN1bGF0ZSBhcmVhIG9mIG9idGFpbmVkIHBvbHlnb25zIA0KDQoNCiMjIFBhY2thZ2VzDQoNCmBgYHtyfQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KHNmKQ0KbGlicmFyeSh0bWFwKQ0KbGlicmFyeShsZWFmbGV0KQ0KYGBgDQoNCiMjIERhdGENCg0KYGBge3J9DQp1Y3NmaSA8LSByZWFkX3NmKCJkYXRhL3Vjc2ZpLnNocCIpICAjICU+JSBgc3RfY3JzPC1gKDM4NTcpICAjIDM4NTcgaXMgV2ViIG1lcmNhdG9yDQpicmF6aWwwIDwtIHJlYWRfc2YoImRhdGEvQlJBX2FkbS9CUkFfYWRtMC5zaHAiKQ0KYGBgDQoNCg0KIyMgUHJvamVjdGlvbg0KDQpJbiB0aGUgYWJvdmUgY29kZSBjaHVuayBwcm9qZWN0aW9uIGlzIGNvbW1lbnRlZCBvdXQgYmVjYXVzZSB0bWFwIGFwcGVhcnMgdG8gd29yayBiZXNldCAqKndpdGhvdXQqKiB0aGUgcHJvamVjdGlvbiBhc3NpZ25lZC4gIFdlJ2xsIGRvIHRoYXQgbGF0ZXIuIGFzc2lnbmVkIHdpdGggYHN0X2NycygpYCB1c2luZyBhIHNvbWV3aGF0IG5vbi1zdGFuZGFyZCBzeW50YXguIEhvd2V2ZXIsIEl0IHNlZW1lZCB0byBiZSB0aGUgb25seSB3YXkgSSBjb3VsZCBhZGQgYSBwcm9qZWN0aW9uIHRvIHRoaXMgcGFydGljdWxhciBzaGFwZWZpbGUuICBCZWxvdyBhcmUgc29tZSBvdGhlciBzeW50YXggZXhhbXBsZXMgdGhhdCBoYXZlIHdvcmtlZCBmb3IgbWUgd2l0aCBvdGhlciBzaGFwZWZpbGVzLiAgT2YgY291cnNlIHRoZXJlIGFyZSB2YXJpb3VzIHdheXMgdG8gYWRkIHByb2plY3Rpb24gYW5kIHNpbmNlIHRoaXMgaXMgUiwgdGhlcmUncyBtb3JlIHRoYW4gb25lIHdheSB0byBhY2NvbXBsaXNoIHRoZSBnb2FsLg0KDQpgYGB7fQ0Kc2Y6OnN0X2NycygzODU3KQ0Kc2Y6OnN0X3RyYW5zZm9ybSgzODU3KQ0KZ2dwbG90Mjo6Y29vcmRfc2YoY3JzID0gMzg1NykgICAjIG11c3QgdXNlIHRoZSBkZXZlbG9wbWVudCB2ZXJzaW9uIG9mIGdncGxvdDINCg0KYGBgDQoNCiMjIyBOb3RlcyBvbiBQcm9qZWN0aW9uDQoNCkZyb20gW0JyYXppbGxpYW4gQ1JTXShodHRwczovL3dpa2kub3NnZW8ub3JnL3dpa2kvQnJhemlsaWFuX0Nvb3JkaW5hdGVfUmVmZXJlbmNlX1N5c3RlbXMpDQoNCi0gNDk4OSANCi0gNDY3NA0KLSA1NTI3DQotIDQ2MTgNCg0KDQojIyMgQ2hlY2sgUHJvamVjdGlvbg0KDQpgYGB7cn0NCnN0X2Nycyh1Y3NmaSkNCnByaW50KCJ1Y3NmaSBhYm92ZSBeXl4gIC0tLS0tLS0tLSBicmF6aWwwIGJlbG93IikNCnN0X2NycyhicmF6aWwwKQ0KDQojIG9yIGNoZWNrIHRoZSBwcm9qZWN0aW9uIGZvciBhbiBpbmRpdmlkdWFsIHBvbHlnb24gLi4uDQojIHVjc2ZpJGdlb21ldHJ5ICU+JSBoZWFkKDEpIA0KYGBgDQoNCiMjIEZpcnN0IFZpZXcgV2l0aCBQcm9qZWN0aW9uDQoNCiMjIyBEYXRhIFByZXZpZXcNCg0KYGBge3J9DQphc190aWJibGUodWNzZmkpDQpgYGANCg0KIyMjIFdyYW5nbGUgRGF0YQ0KDQpJIHdhbnQgdG8gdXNlIGEgbnVtZXJpYyBkYXRhIHR5cGUgYXMgbXkgImZpbGwiDQoNCmBgYHtyfQ0KdWNzZmkgPC0gdWNzZmkgJT4lIA0KICBtdXRhdGUoR0lENyA9IGFzLm51bWVyaWMoR0lENykpDQpgYGANCg0KDQojIyMgRmlyc3QgTG9vayB3aXRoIHRtYXANCg0KYGBge3J9DQp0bWFwX21vZGUoInBsb3QiKQ0KDQp0bV9zaGFwZShicmF6aWwwLCBwcm9qZWN0aW9uID0gMzg1NykgKyB0bV9maWxsKCkgKyB0bV90ZXh0KCJOQU1FXzAiLCBhdXRvLnBsYWNlbWVudCA9IEZBTFNFKSArDQogIHRtX3NoYXBlKHVjc2ZpLCBwcm9qZWN0aW9uID0gMzg1NykgKyB0bV9maWxsKCJHSUQ3IiwgcGFsZXR0ZSA9IHJldihzZi5jb2xvcnMoKSkpDQpgYGANCg0KDQojIyMgZ2dwbG90DQoNCmBgYHtyfQ0KdWNzZmkgJT4lIA0KICBtdXRhdGUoQU5PX0NSSUE2ID0gYXMubnVtZXJpYyhBTk9fQ1JJQTYpKSAlPiUgDQogIGdncGxvdCgpICsNCiAgZ2VvbV9zZihhZXMoZmlsbCA9IEFOT19DUklBNiwgY29sb3IgPSBBTk9fQ1JJQTYpKSANCmBgYA0KDQoNCiMjIyBMb29rIDMgLS0gTGVhZmxldA0KDQpgYGB7cn0NCk1hcFBhbGV0dGUgPC0gY29sb3JRdWFudGlsZShwYWxldHRlID0gInZpcmlkaXMiLCBkb21haW4gPSB1Y3NmaSRHSUQ3LCBuID0gNywgcmV2ZXJzZSA9IFRSVUUpDQpgYGANCg0KDQpgYGB7cn0NCnVjc2ZpICU+JSANCiAgbGVhZmxldCh3aWR0aCA9ICIxMDAlIikgJT4lIA0KICBhZGRQcm92aWRlclRpbGVzKCBwcm92aWRlciA9ICJDYXJ0b0RCLlBvc2l0cm9uIikgJT4lIA0KICBhZGRQb2x5Z29ucyhwb3B1cCA9IH4gSURfVUMwLA0KICAgICAgICAgICAgICBzdHJva2UgPSBGQUxTRSwNCiAgICAgICAgICAgICAgc21vb3RoRmFjdG9yID0gMCwNCiAgICAgICAgICAgICAgZmlsbE9wYWNpdHkgPSAwLjcsDQogICAgICAgICAgICAgIGNvbG9yID0gfiBNYXBQYWxldHRlKEdJRDcpKSANCiMrDQojICBhZGRMZWdlbmQoImJvdHRvbXJpZ2h0IiwgDQojICAgICAgICAgICAgICBwYWwgPSBNYXBQYWxldHRlLCANCiMgICAgICAgICAgICAgIHZhbHVlcyA9IH4gR0lENywNCiMgICAgICAgICAgICAgIHRpdGxlID0gIkdJRDciLA0KIyAgICAgICAgICAgICAgb3BhY2l0eSA9IDEpDQpgYGANCiANCg0K